home *** CD-ROM | disk | FTP | other *** search
/ Oh!X 2001 Spring / Oh!X 2001 Spring Special CD-ROM (Japan).7z / Oh!X 2001 Spring Special CD-ROM (Japan) (Track 1).bin / TCLTK / OCTREV / octrev.tcl < prev    next >
Text File  |  2000-05-07  |  8KB  |  333 lines
  1. #
  2. # octrev.tcl : ８角リバーシ
  3. #
  4. #               Copyright (C) 2000 by Makoto Hiroi
  5. #
  6. # 大域変数
  7. # piece()   : 駒を表す図形 id を格納
  8. # action    : 0 : 先手, 1 : 後手
  9. # color     : 駒の色
  10. # play_flag : ゲーム進行用フラグ 1 :先手（黒）, 2 : 後手（白）
  11. # level     : 思考レベル
  12. # message   : メッセージ表示用ラベル
  13. # score     : 玉数表示用ラベル
  14. # last_score: 最終スコア予想
  15. # black_piece : 黒の残り（DLL 側でセット）
  16. # white_piece : 白の残り（DLL 側でセット）
  17. # VALUE       : 評価値（DLL 側でセット）
  18. #
  19. # octrev.dll で追加されるコマンド
  20. #
  21. # init_game                  : ゲームの初期化
  22. # think $level $turn $random : 思考ルーチン
  23. # reverse $n $turn           : ひっくり返る位置をリストで返す
  24. # check_reverse $n $turn     : 駒を裏返すことができるか
  25. # count_place $turn          : 駒を置ける場所の数
  26. #
  27.  
  28. # 思考ルーチンロード
  29. load octrev.dll
  30.  
  31. # ヘルプファイルの表示
  32. proc help {} {
  33.     global argv0
  34.     if {![winfo exist .t0]} {
  35.         toplevel .t0
  36.         wm title .t0 "Oct Reversi Help"
  37.         text .t0.text -yscrollcommand ".t0.scroll set"
  38.         scrollbar .t0.scroll -command ".t0.text yview"
  39.     pack .t0.scroll -side right -fill y
  40.     pack .t0.text -side left
  41.     # 起動パスを取得
  42.     set path [file dirname $argv0]
  43.     # ファイルの読み込み
  44.     set f [open "$path/octrev.txt" r]
  45.     while {![eof $f]} {
  46.         .t0.text insert end [read $f 1000]
  47.     }
  48.     close $f
  49.     .t0.text configure -state disabled
  50.     }
  51. }
  52.  
  53. # 駒を描画する
  54. proc draw_piece {n c} {
  55.     global piece color
  56.     .c0 itemconfigure $piece($n) -fill $color($c)
  57.     .c0 raise $piece($n)
  58. }
  59.  
  60. # 駒を置く
  61. proc put_piece {piece_list turn} {
  62.     foreach n $piece_list {
  63.     draw_piece $n $turn
  64.     update
  65.     after 250
  66.     }
  67.     display_score
  68. }
  69.  
  70. # メッセージの表示
  71. proc display_message {m} {
  72.     global message mes_table
  73.     set message $mes_table($m)
  74.     update
  75.     after 500
  76. }
  77.  
  78. # スコアの表示
  79. proc display_score {} {
  80.     global score white_piece black_piece
  81.     set score [format "黒 %2d 石 : 白 %2d 石" $black_piece $white_piece]
  82.     update
  83. }
  84.  
  85. # 予想スコアの表示
  86. proc display_last_score {} {
  87.     global last_score VALUE
  88.     set result [expr abs($VALUE)]
  89.     if {$VALUE > 0 } {
  90.     .ll configure -fg black
  91.     set m [format "黒の %2d 石勝ちでしょう" $result]
  92.     } elseif {$VALUE < 0} {
  93.     .ll configure -fg white
  94.     set m [format "白の %2d 石勝ちでしょう" $result]
  95.     } else {
  96.     set m "引き分けでしょう"
  97.     }
  98.     set last_score $m
  99.     update
  100. }
  101.  
  102. # 終了ダイアログ    
  103. proc game_over {} {
  104.     global play_flag action white_piece black_piece
  105.     set c [expr $black_piece - $white_piece]
  106.     if {$c == 0} {
  107.     set m "引き分けです"
  108.     } elseif {($action == 0 && $c > 0) || ($action == 1 && $c < 0)} {
  109.     set m "あなたの勝ちです"
  110.     } else {
  111.     set m "私の勝ちです"
  112.     }
  113.     tk_messageBox -type ok -message $m
  114.     set play_flag 0
  115.     display_message start
  116. }
  117.  
  118. # 探索レベルの決定
  119. proc decide_level {level} {
  120.     global white_piece black_piece
  121.     set rest [expr 60 - $white_piece - $black_piece]
  122.     # レベル５で残り 14 手で読み切り
  123.     if {[expr 9 + $level] >= $rest} {
  124.     # 読み切りモード
  125.     display_message finish
  126.     return 20
  127.     }
  128.     return $level
  129. }
  130.  
  131. # コンピュータ側の手番
  132. proc put_piece_com {} {
  133.     global play_flag level action white_piece black_piece random
  134.     # コマンド think で使う大域変数
  135.     global VALUE
  136.     while {1} {
  137.     . configure -cursor wait
  138.     display_message com_turn
  139.     set turn [expr $play_flag - 1]
  140.     set lv [decide_level $level] 
  141.     set result [think $lv $turn $random]
  142.     . configure -cursor "" 
  143.     if {$lv == 20} {
  144.         display_last_score
  145.     }
  146.     put_piece $result $turn 
  147.     # 状態チェック
  148.     if {[count_place $action] == 0} {
  149.         if {[count_place $turn] == 0} {
  150.         game_over
  151.         return
  152.         } else {
  153.         # 相手がパスだよ
  154.         display_message pass
  155.         }
  156.     } else {
  157.         break;
  158.     }
  159.     }
  160.     # 手番を移す
  161.     if {$play_flag == 1} {
  162.     set play_flag 2
  163.     } else {
  164.     set play_flag 1
  165.     }
  166.     display_message my_turn
  167. }
  168.  
  169. # 人間側の指し手
  170. proc put_piece_human {n} {
  171.     global play_flag white_piece black_piece action message
  172.     # 自分の手番かチェックする
  173.     if {$play_flag != [expr $action + 1]} return
  174.     # 駒を反転できるかチェックする
  175.     if ![check_reverse $n $action] return
  176.     # 二重入力防止
  177.     set $play_flag -1
  178.     # 駒の位置がリストで返される
  179.     put_piece [reverse $n $action] $action
  180.     # 状態チェック
  181.     if {[count_place [expr !$action]] == 0} {
  182.     if {[count_place $action] == 0} {
  183.         # 両方とも打つ場所無し
  184.         game_over
  185.         return
  186.     } else {
  187.         # 相手はパスだよ
  188.         display_message pass
  189.         display_message my_turn
  190.         return
  191.     }
  192.     }
  193.     # 元に戻す
  194.     set play_falg [expr $action + 1]
  195.  
  196.     # 手番を移す
  197.     if {$play_flag == 1} {
  198.     set play_flag 2
  199.     } else {
  200.     set play_flag 1
  201.     }
  202.     display_message com_turn
  203.     put_piece_com
  204. }
  205.  
  206. # 中断ダイアログ
  207. proc break_dialog {} {
  208.     set ans [tk_messageBox -type yesno -icon question \
  209.                        -message "今のゲームを中断しますか？"]
  210.     return [expr {($ans == "no") ? 0 : 1}]
  211. }
  212.  
  213. # 駒を隠す
  214. proc hide_piece {} {
  215.     global piece
  216.     for {set i 0} {$i < 64} {incr i} {
  217.     .c0 lower $piece($i)
  218.     }
  219. }
  220.  
  221. # ゲームの開始
  222. proc new_game {} {
  223.     global play_flag action white_piece black_piece last_score
  224.     if {$play_flag != 0} {
  225.     if ![break_dialog] return
  226.     set play_flag 0
  227.     }
  228.     hide_piece
  229.     if {$play_flag == 0 } {
  230.     # ゲーム開始
  231.     init_game
  232.     set white_piece 2
  233.     set black_piece 2
  234.     # 最初の駒を描画
  235.     draw_piece 27 1
  236.     draw_piece 28 0
  237.     draw_piece 35 0
  238.     draw_piece 36 1
  239.     set play_flag 1
  240.     set last_score ""
  241.     display_score
  242.     if $action {
  243.         put_piece_com
  244.     } else {
  245.         display_message my_turn
  246.     }
  247.     }
  248. }
  249.  
  250. # グローバル変数の初期化
  251. proc init_global {} {
  252.     global level action mes_table play_flag message color random
  253.     set level 1
  254.     set random 1
  255.     set action 0
  256.     set play_flag 0
  257.     set color(0) black
  258.     set color(1) white
  259.     set mes_table(start)    "メニュー Games の Start でゲーム開始！"
  260.     set mes_table(my_turn)  "あなたの手番です"
  261.     set mes_table(com_turn) "わたしの手番です"
  262.     set mes_table(pass)     "・・・パスです・・・"
  263.     set mes_table(finish)   "最後まで読み切ります！"
  264.     set message $mes_table(start)
  265. }
  266.  
  267. # ********** メニューの設定 **********
  268. menu .m -type menubar
  269. . configure -menu .m
  270. .m add cascade -label "Games" -under 0 -menu .m.m1
  271. .m add cascade -label "Level" -under 0 -menu .m.m2
  272. .m add command -label "Help"  -under 0 -command "help"
  273. menu .m.m1 -tearoff no
  274. .m.m1 add command -label "Start" -under 0 -command "new_game"
  275. .m.m1 add separator
  276. .m.m1 add radiobutton -label "先手" -variable action -value 0
  277. .m.m1 add radiobutton -label "後手" -variable action -value 1
  278. .m.m1 add separator
  279. .m.m1 add checkbutton -label "Rand" -variable random
  280. .m.m1 add separator
  281. .m.m1 add command -label "Exit" -under 0 -command "exit"
  282. menu .m.m2 -tearoff no
  283. .m.m2 add radiobutton -label "Level 0" -variable level -value 0
  284. .m.m2 add radiobutton -label "Level 1" -variable level -value 1
  285. .m.m2 add radiobutton -label "Level 2" -variable level -value 2
  286. .m.m2 add radiobutton -label "Level 3" -variable level -value 3
  287. .m.m2 add radiobutton -label "Level 4" -variable level -value 4
  288. .m.m2 add radiobutton -label "Level 5" -variable level -value 5
  289.  
  290. # ********** 画面の生成 **********
  291. option add *font "{ＭＳ 明朝} 12"
  292. canvas .c0 -width 340 -height 340 -bg green4
  293.  
  294. # 図形の初期化  マスのサイズは 40 * 40 
  295. for {set n 0; set y 0} {$y < 8} {incr y} {
  296.     for {set x 0} {$x < 8} {incr x} {
  297.     set x1 [expr $x * 40 + 10]
  298.     set y1 [expr $y * 40 + 10]
  299.     set x2 [expr $x1 + 40]
  300.     set y2 [expr $y1 + 40]
  301.     if { !(($n == 0) || ($n == 7) ||($n == 56) || ($n == 63)) } {
  302.         set i [.c0 create rectangle $x1 $y1 $x2 $y2 -fill green4]
  303.         .c0 bind $i <Button-1> "put_piece_human $n"
  304.     }
  305.         # 石の描画
  306.     incr x1 4
  307.     incr y1 4
  308.     incr x2 -4
  309.     incr y2 -4
  310.     set piece($n) [.c0 create oval $x1 $y1 $x2 $y2 -outline green4]
  311.     .c0 lower $piece($n)
  312.     incr n 1
  313.     }
  314. }
  315.  
  316. # メッセージ表示用ラベル
  317. label .lm -textvariable message -bg green4 -fg yellow
  318. # スコア表示用
  319. label .ls -textvariable score -bg green4 -fg white
  320. # 予想スコア
  321. label .ll -textvariable last_score -bg green4 -fg black
  322.  
  323. pack .ls .lm .ll .c0 -fill x
  324.  
  325. init_global
  326.  
  327. wm title . "Reversi"
  328. wm resizable . 0 0
  329. focus -force .
  330.  
  331. # end of file
  332.  
  333.